home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tables / HLTEST.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  3.8 KB  |  106 lines
  1.         PROGRAM HLTEST
  2.  
  3.         INTEGER HEAP(20000),A(100),I
  4.  
  5.         INTEGER LLCRHE,LLCRHD,LLCREL,LLCRED,LLFIRS,LLLAST,LLNEXT,LLPREV,
  6.      +          LLHEAD,LLPRED,HALLOC,HGET1
  7.         EXTERNAL ZINIT,REMARK,ZQUIT
  8.  
  9.         CALL ZINIT
  10.  
  11.         CALL REMARK('Heap & List Sub-library Test Program')
  12.  
  13.         CALL HINIT(HEAP,20000)
  14.  
  15.         DO 100 I=1,100
  16.             A(I)=HALLOC(HEAP,I+50)
  17.  100    CONTINUE
  18.  
  19.         DO 200 I=2,100,2
  20.             CALL HFREE(HEAP,A(I))
  21.  200    CONTINUE
  22.  
  23.         DO 300 I=2,100,2
  24.             A(I)=HALLOC(HEAP,70+I)
  25.  300    CONTINUE
  26.  
  27.         DO 400 I=1,100
  28.             CALL HFREE(HEAP,A(I))
  29.  400    CONTINUE
  30.  
  31.         CALL REMARK('Basic HEAP test complete')
  32.  
  33.         DO 500 I=1,10
  34.             A(I)=LLCRHE(HEAP,0)
  35.  500    CONTINUE
  36.  
  37.         DO 600 I=11,20
  38.             A(I)=LLCREL(HEAP,0)
  39.  600    CONTINUE
  40.  
  41.         DO 700 I=11,20
  42.             CALL LLINTO(HEAP,A(I),A(I-10))
  43.  700    CONTINUE
  44.  
  45.         DO 800 I=1,10
  46.             IF (LLFIRS(HEAP,A(I)).NE.A(I+10))
  47.      +          CALL ERROR('LLINTO/LLFIRS failure')
  48.             IF (LLLAST(HEAP,A(I)).NE.A(I+10))
  49.      +          CALL ERROR('LLINTO/LLLAST failure')
  50.             IF (LLNEXT(HEAP,A(I+10)).NE.0) CALL ERROR('LLNEXT failure')
  51.             IF (LLPREV(HEAP,A(I+10)).NE.0) CALL ERROR('LLPREV failure')
  52.             IF (LLPRED(HEAP,A(I+10)).NE.A(I))
  53.      +          CALL ERROR('LLPRED failure 1')
  54.             IF (LLPRED(HEAP,A(I)).NE.A(I+10))
  55.      +          CALL ERROR('LLPRED failure 2')
  56.             IF (LLHEAD(HEAP,A(I+10)).NE.A(I))
  57.      +          CALL ERROR('LLHEAD failure 1')
  58.  800    CONTINUE
  59.  
  60.         I=HGET1(HEAP)
  61.         IF (I.EQ.HGET1(HEAP)) CALL ERROR('HGET1 failure')
  62.         HEAP(I)=0
  63.         HEAP(HGET1(HEAP))=0
  64.  
  65.         CALL LLOUT(HEAP,A(11))
  66.         IF (LLFIRS(HEAP,A(1)).NE.0) CALL ERROR('LLOUT failure 1')
  67.         IF (LLLAST(HEAP,A(1)).NE.0) CALL ERROR('LLOUT failure 1A')
  68.         IF (LLPRED(HEAP,A(11)).NE.0) CALL ERROR('LLOUT failure 1B')
  69.         IF (LLNEXT(HEAP,A(11)).NE.0) CALL ERROR('LLOUT failure 1C')
  70.         CALL LLFOLL(HEAP,A(11),A(1))
  71.         IF (LLFIRS(HEAP,A(1)).NE.A(11)) CALL ERROR('LLFOLL failure 1')
  72.         IF (LLLAST(HEAP,A(1)).NE.A(11)) CALL ERROR('LLFOLL failure 1A')
  73.         IF (LLPREV(HEAP,A(11)).NE.0) CALL ERROR('LLFOLL failure 1B')
  74.         IF (LLNEXT(HEAP,A(11)).NE.0) CALL ERROR('LLFOLL failure 1C')
  75.         IF (LLPRED(HEAP,A(11)).NE.A(1)) CALL ERROR('LLFOLL failure 1D')
  76.         CALL LLFOLL(HEAP,A(11),A(12))
  77.         IF (LLFIRS(HEAP,A(1)).NE.0) CALL ERROR('LLFOLL failure 2')
  78.         IF (LLFIRS(HEAP,A(2)).NE.A(12)) CALL ERROR('LLFOLL failure 3')
  79.         IF (LLLAST(HEAP,A(2)).NE.A(11)) CALL ERROR('LLFOLL failure 4')
  80.         IF (LLNEXT(HEAP,A(12)).NE.A(11)) CALL ERROR('LLFOLL failure 5')
  81.         IF (LLPREV(HEAP,A(11)).NE.A(12)) CALL ERROR('LLFOLL failure 6')
  82.         IF (LLHEAD(HEAP,A(11)).NE.LLHEAD(HEAP,A(12)))
  83.      +      CALL ERROR('LLHEAD failure 2')
  84.         CALL LLFOLL(HEAP,A(13),A(2))
  85.         IF (LLFIRS(HEAP,A(3)).NE.0) CALL ERROR('LLFOLL failure 7')
  86.         IF (LLFIRS(HEAP,A(2)).NE.A(13)) CALL ERROR('LLFOLL failure 8')
  87.         IF (LLLAST(HEAP,A(2)).NE.A(11)) CALL ERROR('LLFOLL failure 9')
  88.         IF (LLNEXT(HEAP,A(13)).NE.A(12)) CALL ERROR('LLFOLL failure 10')
  89.         IF (LLPREV(HEAP,A(12)).NE.A(13)) CALL ERROR('LLFOLL failure 11')
  90.         IF (LLNEXT(HEAP,A(11)).NE.0) CALL ERROR('LLFOLL failure 12')
  91.         CALL LLINTO(HEAP,A(14),A(2))
  92.         IF (LLLAST(HEAP,A(2)).NE.A(14)) CALL ERROR('LLINTO failure 2')
  93.         CALL LLOUT(HEAP,A(13))
  94.         IF (LLFIRS(HEAP,A(2)).NE.A(12)) CALL ERROR('LLOUT failure 2')
  95.         IF (LLPREV(HEAP,A(12)).NE.0) CALL ERROR('LLOUT failure 2')
  96.         CALL LLDELE(HEAP,A(12))
  97.         IF (LLFIRS(HEAP,A(2)).NE.A(11)) CALL ERROR('LLDELE failure')
  98.         CALL LLDELH(HEAP,A(1))
  99.  
  100. C LLCRHD/LLCRED not tested
  101.  
  102.         CALL REMARK('Test Complete.')
  103.         CALL ZQUIT(-2)
  104.  
  105.         END
  106.